;; Copyright (c) [2022] [bobwxc]
;; This file is licensed under Mulan PubL v2.
;; You can use this software according to the terms and conditions of the Mulan PubL v2.
;; You may obtain a copy of Mulan PubL v2 at:
;;          http://license.coscl.org.cn/MulanPubL-2.0
;; THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OF ANY KIND,
;; EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO NON-INFRINGEMENT,
;; MERCHANTABILITY OR FIT FOR A PARTICULAR PURPOSE.
;; See the Mulan PubL v2 for more details.

(defpackage #:ctime
  (:nicknames #:ct)
  (:documentation "a Common Lisp interface for glibc date and time part")
  (:use #:cl
        #:cffi)
  (:export #:c-time
           #:c-gettimeofday
           #:c-localtime
           #:c-gmtime
           #:c-mktime
           #:c-timelocal
           #:c-timegm
           #:c-difftime
           #:c-asctime
           #:c-ctime
           #:c-strftime
           #:c-strptime
           #:*tzname*
           #:*timezone*
           #:*daylight*
           ))

(in-package #:ctime)

(define-foreign-library libc
  (:darwin (:or "libc.6.dylib" "libc.dylib"))
  ;; (:unix (:or "/lib/x86_64-linux-gnu/libc.so.6" "/lib/x86_64-linux-gnu/libc.so"))
  (:unix (:or "libc.so.6" "libc.so"))
  (:windows (or "msvcrt.dll" "libc.dll"))
  (t (:default "libc")))

(use-foreign-library libc)

(defcfun (time1 "time") :long-long ;; time_t is :long-long
  (ts (:pointer :long-long)))

(defun c-time ()
  (with-foreign-pointer (ts 8)
    (time1 ts)
    (mem-ref ts :long-long)))

;; (print (c-time))

(defcstruct timeval
  (tv_sec :long-long)
  (tv_usec :int))

(defcstruct timezone_
  (tz_minuteswest :int)
  (tz_dsttime :int))

(defcfun (gettimeofday "gettimeofday") :int
  (tv (:pointer (:struct timeval)))
  (tz (:pointer (:struct timezone_))))

(defun c-gettimeofday ()
  (with-foreign-objects ((tv '(:struct timeval)))
    ;; (tz '(:struct timezone_)))

    ;; (setf (foreign-slot-value tv '(:struct timeval) 'tv_sec) (cffi:null-pointer)
    ;;       (foreign-slot-value tv '(:struct timeval) 'tv_usec) (cffi:null-pointer))
    (let ((r (gettimeofday tv (cffi:null-pointer))))
      (when (/= r 0)
        (error " !!! ctime:gettimeofday error code ~D !!!~%" r)))

    (cons (cffi:foreign-slot-value tv '(:struct timeval) 'tv_sec)
          (cffi:foreign-slot-value tv '(:struct timeval) 'tv_usec))))

;; (print (c-gettimeofday))

(defcstruct timespec
  (tvsec :long-long)
  (tvnsec :long-long))

(defcstruct tm
  (tm_sec :int) ;; 0-59 (sometimes 60)
  (tm_min :int) ;; 0-59
  (tm_hour :int) ;; 0-23
  (tm_mday :int) ;; 1-31
  (tm_mon :int) ;; 0-11
  (tm_year :int) ;; year since 1900
  (tm_wday :int) ;; 0-6
  (tm_yday :int) ;; 0-365
  (tm_isdst :int) ;; flag for Daylight Saving Time, >0 yes, =0 no, <0 uncertain
  (tm_gmtoff :long-long) ;; timezone, the seconds add to UTC to get local time
  (tm_zone :string)) ;; BSD/GNU extension time zone

(defcfun (localtime_r "localtime_r") (:pointer (:struct tm))
  (timestamp (:pointer :long-long))
  (resultp (:pointer (:struct tm))))

(defun c-localtime (timestamp)
  (+ timestamp 0) ;; mask un-used warning
  (with-foreign-pointer (ts 8 timestamp)
    (with-foreign-object (r '(:struct tm))
      (when (null-pointer-p (localtime_r ts r))
        (error "!!! ctime:c-localtime return NULL !!!~%"))
      (list
       (cons 'tm-sec (cffi:foreign-slot-value r '(:struct tm) 'tm_sec))
       (cons 'tm-min (cffi:foreign-slot-value r '(:struct tm) 'tm_min))
       (cons 'tm-hour (cffi:foreign-slot-value r '(:struct tm) 'tm_hour))
       (cons 'tm-mday (cffi:foreign-slot-value r '(:struct tm) 'tm_mday))
       (cons 'tm-mon (cffi:foreign-slot-value r '(:struct tm) 'tm_mon))
       (cons 'tm-year (+ 1900 (cffi:foreign-slot-value r '(:struct tm) 'tm_year))) ;; real year
       (cons 'tm-wday (cffi:foreign-slot-value r '(:struct tm) 'tm_wday))
       (cons 'tm-yday (cffi:foreign-slot-value r '(:struct tm) 'tm_yday))
       (cons 'tm-isdst (cffi:foreign-slot-value r '(:struct tm) 'tm_isdst))
       (cons 'tm-gmtoff (cffi:foreign-slot-value r '(:struct tm) 'tm_gmtoff))
       (cons 'tm-zone (cffi:foreign-slot-value r '(:struct tm) 'tm_zone)))
      )))

;; (print (c-localtime (c-time)))

(defcfun (gmtime_r "gmtime_r") (:pointer (:struct tm))
  (timestamp (:pointer :long-long))
  (resultp (:pointer (:struct tm))))

(defun c-gmtime (timestamp)
  (+ timestamp 0) ;; mask un-used warning
  (with-foreign-pointer (ts 8 timestamp)
    (with-foreign-object (r '(:struct tm))
      (when (null-pointer-p (gmtime_r ts r))
        (error "!!! ctime:c-gmtime return NULL !!!~%"))
      (list
       (cons 'tm-sec (cffi:foreign-slot-value r '(:struct tm) 'tm_sec))
       (cons 'tm-min (cffi:foreign-slot-value r '(:struct tm) 'tm_min))
       (cons 'tm-hour (cffi:foreign-slot-value r '(:struct tm) 'tm_hour))
       (cons 'tm-mday (cffi:foreign-slot-value r '(:struct tm) 'tm_mday))
       (cons 'tm-mon (cffi:foreign-slot-value r '(:struct tm) 'tm_mon))
       (cons 'tm-year (+ 1900 (cffi:foreign-slot-value r '(:struct tm) 'tm_year))) ;; real year
       (cons 'tm-wday (cffi:foreign-slot-value r '(:struct tm) 'tm_wday))
       (cons 'tm-yday (cffi:foreign-slot-value r '(:struct tm) 'tm_yday))
       (cons 'tm-isdst (cffi:foreign-slot-value r '(:struct tm) 'tm_isdst))
       (cons 'tm-gmtoff (cffi:foreign-slot-value r '(:struct tm) 'tm_gmtoff))
       (cons 'tm-zone (cffi:foreign-slot-value r '(:struct tm) 'tm_zone)))
      )))

;; (print (c-gmtime (c-time)))

(defcfun (mktime "mktime") :long-long
  (brokentime (:pointer (:struct tm))))

(defun c-mktime (bt)
  (with-foreign-object (cbt '(:struct tm))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_sec) (cdr (assoc 'tm-sec bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_min) (cdr (assoc 'tm-min bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_hour) (cdr (assoc 'tm-hour bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_mday) (cdr (assoc 'tm-mday bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_mon) (cdr (assoc 'tm-mon bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_year) (- (cdr (assoc 'tm-year bt)) 1900))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_wday) (cdr (assoc 'tm-wday bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_yday) (cdr (assoc 'tm-yday bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_isdst) (cdr (assoc 'tm-isdst bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_gmtoff) (cdr (assoc 'tm-gmtoff bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_zone) (cdr (assoc 'tm-zone bt)))
    (let ((r (mktime cbt)))
      (if (= r -1)
          (error "!!! ctime:c-mktime error code ~D !!!~%" r)
        r))
    ))

;; (print (c-mktime (c-localtime (c-time))))

(defun c-timelocal (bt)
  (c-mktime bt))

(defcfun (timegm "timegm") :long-long
  (brokentime (:pointer (:struct tm))))

(defun c-timegm (bt)
  (with-foreign-object (cbt '(:struct tm))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_sec) (cdr (assoc 'tm-sec bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_min) (cdr (assoc 'tm-min bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_hour) (cdr (assoc 'tm-hour bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_mday) (cdr (assoc 'tm-mday bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_mon) (cdr (assoc 'tm-mon bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_year) (- (cdr (assoc 'tm-year bt)) 1900))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_wday) (cdr (assoc 'tm-wday bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_yday) (cdr (assoc 'tm-yday bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_isdst) (cdr (assoc 'tm-isdst bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_gmtoff) (cdr (assoc 'tm-gmtoff bt)))
    (setf (foreign-slot-value cbt '(:struct tm) 'tm_zone) (cdr (assoc 'tm-zone bt)))
    (let ((r (timegm cbt)))
      (if (= r -1)
          (error "!!! ctime:c-timegm error code ~D !!!~%" r)
        r))
    ))

;; (print (c-timegm (c-localtime (c-time))))

(defcfun (difftime "difftime") :double
  (end :long-long)
  (begin :long-long))

(defun c-difftime (end begin)
  (difftime end begin))

;; (print (c-difftime 1652574193 1652545264))

(defcfun (asctime_r "asctime_r") :string
  (brokentime (:pointer (:struct tm)))
  (buffer :string))

(defun c-asctime (bt)
  (with-foreign-pointer-as-string (buf 26)
    (with-foreign-object (cbt '(:struct tm))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_sec) (cdr (assoc 'tm-sec bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_min) (cdr (assoc 'tm-min bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_hour) (cdr (assoc 'tm-hour bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_mday) (cdr (assoc 'tm-mday bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_mon) (cdr (assoc 'tm-mon bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_year) (- (cdr (assoc 'tm-year bt)) 1900))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_wday) (cdr (assoc 'tm-wday bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_yday) (cdr (assoc 'tm-yday bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_isdst) (cdr (assoc 'tm-isdst bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_gmtoff) (cdr (assoc 'tm-gmtoff bt)))
      (setf (foreign-slot-value cbt '(:struct tm) 'tm_zone) (cdr (assoc 'tm-zone bt)))
      (let ((r (asctime_r cbt buf)))
        (when (equal r nil)
          (error "!!! ctime:c-asctime return NULL !!!~%")))
      buf)))

;; (print (c-asctime (c-localtime (c-time))))

(defcfun (ctime_r "ctime_r") :string
  (timestamp (:pointer :long-long))
  (buffer :string))

(defun c-ctime (timestamp)
  (with-foreign-pointer (ts 8)
    (setf (mem-ref ts :long-long) timestamp)
    (with-foreign-pointer-as-string (buf 26)
      (let ((r (ctime_r ts buf)))
        (when (equal r nil)
          (error "!!! ctime:c-ctime return NULL !!!~%")))
      buf)))

;; (print (c-ctime (c-time)))

(defcfun (strftime "strftime") :long-long
  (buf :string)
  (bufsize :int)
  (fmt :string)
  (brokentime (:pointer (:struct tm))))

(defun c-strftime (fmt bt &optional (maxlen 100))
  (with-foreign-pointer-as-string (buf maxlen) ;; default max len is 100
    (with-foreign-string (cfmt fmt)
      (with-foreign-object (cbt '(:struct tm))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_sec) (cdr (assoc 'tm-sec bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_min) (cdr (assoc 'tm-min bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_hour) (cdr (assoc 'tm-hour bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_mday) (cdr (assoc 'tm-mday bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_mon) (cdr (assoc 'tm-mon bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_year) (- (cdr (assoc 'tm-year bt)) 1900))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_wday) (cdr (assoc 'tm-wday bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_yday) (cdr (assoc 'tm-yday bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_isdst) (cdr (assoc 'tm-isdst bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_gmtoff) (cdr (assoc 'tm-gmtoff bt)))
        (setf (foreign-slot-value cbt '(:struct tm) 'tm_zone) (cdr (assoc 'tm-zone bt)))
        (let ((r (strftime buf 100 cfmt cbt)))
          (when (= r 0)
            (warn "ctime:c-strftime return 0, may exceed max length ~D~%" maxlen)))
        buf))))

;; (print (c-strftime "%a, %d %b %Y %T %z" (c-localtime (c-time))))

(defcfun (strptime "strptime") :string
  (s :string)
  (fmt :string)
  (tp (:pointer (:struct tm))))

(defun c-strptime (s fmt)
  (with-foreign-strings ((cs s)
                         (cfmt fmt))
    (with-foreign-object (tp '(:struct tm))
      (let ((r (strptime cs cfmt tp)))
        (when (equal r nil)
          (error "!!! ctime:c-strptime return NULL !!!~%")))
      (list
       (cons 'tm-sec (cffi:foreign-slot-value tp '(:struct tm) 'tm_sec))
       (cons 'tm-min (cffi:foreign-slot-value tp '(:struct tm) 'tm_min))
       (cons 'tm-hour (cffi:foreign-slot-value tp '(:struct tm) 'tm_hour))
       (cons 'tm-mday (cffi:foreign-slot-value tp '(:struct tm) 'tm_mday))
       (cons 'tm-mon (cffi:foreign-slot-value tp '(:struct tm) 'tm_mon))
       (cons 'tm-year (+ 1900 (cffi:foreign-slot-value tp '(:struct tm) 'tm_year))) ;; real year
       (cons 'tm-wday (cffi:foreign-slot-value tp '(:struct tm) 'tm_wday))
       (cons 'tm-yday (cffi:foreign-slot-value tp '(:struct tm) 'tm_yday))
       (cons 'tm-isdst (cffi:foreign-slot-value tp '(:struct tm) 'tm_isdst)))
       ;; No tm_gmtoff nor tm_zone
      )))

;; (print (c-strptime "Thu, 05 May 2022 13:36:03 +0800" "%a, %d %b %Y %T %z"))

(defcvar (*tzname* "tzname") (:array :string 2)
  "timezones name and Daylight Saving standard")

(defcvar (*timezone* "timezone") :long-long
  "the difference between UTC and the latest local standard time (second)")

(defcvar (*daylight* "daylight") :int
  "Daylight Saving Time rules, nonzreo -> apply")

